Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/crwdemo/main.frm

Visual Basic Form | 1995-12-05 | 19.3 KB | 602 lines

VERSION 2.00
Begin MDIForm Main
   Caption         =   "Program Manager"
   ClientHeight    =   5235
   ClientLeft      =   900
   ClientTop       =   2100
   ClientWidth     =   9600
   Height          =   5925
   Icon            =   MAIN.FRX:0000
   Left            =   840
   LinkTopic       =   "Main"
   Top             =   1470
   Width           =   9720
   WindowState     =   2  'Maximized
   Begin SSPanel ToolBar
      Align           =   1  'Align Top
      Height          =   555
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   9600
      Begin CommandButton Command5
         Caption         =   "Cancel"
         Height          =   330
         Left            =   4050
         TabIndex        =   7
         Top             =   90
         Visible         =   0   'False
         Width           =   780
      End
      Begin CommandButton Command4
         Caption         =   ">>"
         Height          =   330
         Left            =   2385
         TabIndex        =   6
         Top             =   90
         Visible         =   0   'False
         Width           =   735
      End
      Begin CommandButton Command3
         Caption         =   "<<"
         Height          =   330
         Left            =   1575
         TabIndex        =   5
         Top             =   90
         Visible         =   0   'False
         Width           =   735
      End
      Begin CommandButton Command2
         Caption         =   ">|"
         Height          =   330
         Left            =   3195
         TabIndex        =   4
         Top             =   90
         Visible         =   0   'False
         Width           =   780
      End
      Begin CommandButton Command1
         Caption         =   "|<"
         Height          =   330
         Left            =   720
         TabIndex        =   3
         Top             =   90
         Visible         =   0   'False
         Width           =   750
      End
      Begin SSCommand Preview
         BevelWidth      =   1
         Height          =   375
         Left            =   120
         Picture         =   MAIN.FRX:0302
         TabIndex        =   2
         Top             =   120
         Width           =   330
      End
      Begin CommonDialog CMDialog1
         DefaultExt      =   "*.rpt"
         DialogTitle     =   "Open Report"
         Filter          =   "Crystal Report(*.rpt)|*.rpt"
         Left            =   9000
         Top             =   0
      End
   End
   Begin SSPanel StatusBar
      Align           =   2  'Align Bottom
      Alignment       =   1  'Left Justify - MIDDLE
      BorderWidth     =   1
      Caption         =   " Ready"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   300
      Left            =   0
      TabIndex        =   0
      Top             =   4935
      Width           =   9600
      Begin Line Line2
         BorderColor     =   &H00FFFFFF&
         X1              =   0
         X2              =   7350
         Y1              =   30
         Y2              =   30
      End
      Begin Line Line1
         BorderColor     =   &H00000000&
         X1              =   0
         X2              =   7350
         Y1              =   15
         Y2              =   15
      End
   End
   Begin Menu MenuFile
      Caption         =   "&File"
      Begin Menu MenuFileNew
         Caption         =   "&New"
      End
      Begin Menu MenuFileClose
         Caption         =   "&Close"
         Enabled         =   0   'False
      End
      Begin Menu MenuFileSep
         Caption         =   "-"
      End
      Begin Menu MenuFileExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu MenuEngine
      Caption         =   "&Engine Management"
      Begin Menu MenuEngineOpen
         Caption         =   "&Open Engine"
      End
      Begin Menu MenuEngineOpenJob
         Caption         =   "&Open Print Job"
      End
      Begin Menu MenuEngineCloseJob
         Caption         =   "&Close Print Job"
      End
      Begin Menu MenuEngineClose
         Caption         =   "&Close Engine"
      End
   End
   Begin Menu MenuFormat
      Caption         =   "&Format"
      Begin Menu MenuFormatRptTitle
         Caption         =   "&Report Title"
      End
      Begin Menu MenuFormatSetMargins
         Caption         =   "&Set Margins"
      End
      Begin Menu MenuFormatSetSecFormat
         Caption         =   "&Set Section Format"
      End
      Begin Menu MenuFormatMinSectionHeight
         Caption         =   "&Set Minimum Section Height"
      End
      Begin Menu MenuFormatSetLineHeight
         Caption         =   "&Set Line Height"
      End
      Begin Menu MenuFormatSetSectionFont
         Caption         =   "&Set Section Font"
      End
   End
   Begin Menu MenuFields
      Caption         =   "&Fields"
      Begin Menu MenuFieldsRecordSortField
         Caption         =   "&Record Sort Fields"
      End
      Begin Menu MenuFieldsGroupSortFields
         Caption         =   "&Group Sort Fields"
      End
      Begin Menu MenuGroupCond
         Caption         =   "&Set Group Condition"
      End
   End
   Begin Menu MenuFormulas
      Caption         =   "&Formulae"
      Begin Menu MenuFormulasSetFormula
         Caption         =   "&Formulae"
      End
      Begin Menu MenuFormulasSetSelForm
         Caption         =   "&Selection Formulae"
      End
   End
   Begin Menu MenuDatabase
      Caption         =   "&Database"
      Begin Menu MenuDBLocation
         Caption         =   "&Location"
      End
      Begin Menu MenuModSQL
         Caption         =   "&Modify SQL"
      End
      Begin Menu MenuLogon
         Caption         =   "&Logon Server"
      End
      Begin Menu MenuLogoff
         Caption         =   "&Logoff Server"
      End
      Begin Menu MenuLogonInfo
         Caption         =   "&Logon Info"
      End
      Begin Menu MenuSecurity
         Caption         =   "&Security"
      End
   End
   Begin Menu MenuPrint
      Caption         =   "&Print"
      Begin Menu MenuPrintdestination
         Caption         =   "&Destination"
      End
   End
   Begin Menu MenuWindow
      Caption         =   "&Window"
      WindowList      =   -1  'True
      Begin Menu MenuWindowCascade
         Caption         =   "&Cascade"
      End
      Begin Menu MenuWindowTileH
         Caption         =   "Tile &Horizontally"
      End
      Begin Menu MenuWindowTileV
         Caption         =   "&Tile Vertically"
      End
      Begin Menu MenuWindowArrange
         Caption         =   "&Arrange"
      End
   End
' Crystal.Vbx doesn't have an Align Property so The ToolBar
' is used as a container.
' The following Default Properties of Crystal.Vbx have been
' changed to:-
'       WindowBorderStyle = 0 - None
'       WindowControlBox = False
'       WindowMaxButton = False
'       WindowMinButton = False
'       WindowLeft = 0      'so that the MoveWindow Function
'       WindowTop = 0       'doesn't jerk the Crystal Window
'                           'across the MDIChild Window.
'--------------------------------------------------------------------
 Dim dllname As String * 20
Sub Command1_Click ()
 If PEShowFirstPage(JobNum) = False Then
   'RCode = PEGetErrorCode(Jobnum)
   'MsgBox "PEShowPreviousPage = " + RCode
 End If
End Sub
Sub Command2_Click ()
 If PEShowLastPage(JobNum) = False Then
   'RCode = PEGetErrorCode(Jobnum)
   'MsgBox "PEShowPreviousPage = " + RCode
 End If
End Sub
Sub Command3_Click ()
 If PEShowPreviousPage(JobNum) = False Then
   'RCode = PEGetErrorCode(Jobnum)
   'MsgBox "PEShowPreviousPage = " + RCode
 End If
End Sub
Sub Command4_Click ()
 If PEShowNextPage(JobNum) = False Then
   'RCode = PEGetErrorCode(Jobnum)
   'MsgBox "PEShowPreviousPage = " + RCode
 End If
End Sub
Sub Command5_Click ()
  PECancelPrintJob (JobNum)
End Sub
Sub MDIForm_Resize ()
    Line1.X2 = Me.ScaleWidth
    Line2.X2 = Me.ScaleWidth
End Sub
Sub MDIForm_Unload (Cancel As Integer)
    If JobNum <> 0 Then
       PEClosePrintJob (JobNum)
       JobNum = 0
    End If
    PECloseEngine
    Unload Me
    End
End Sub
Sub MenuDBLocation_Click ()
 Tablem.Show
End Sub
Sub MenuEditCopy_Click ()
  MsgBox "Not Yet Implemented!"
End Sub
Sub MenuEditCut_Click ()
 MsgBox "Not Yet Implemented!"
End Sub
Sub MenuEditPaste_Click ()
   MsgBox "Not Yet Implemented!"
End Sub
Sub MenuEditUndo_Click ()
 MsgBox "Not Yet Implemented!"
End Sub
Sub MenuEngineClose_Click ()
  PECloseEngine
  Main!StatusBar.Caption = "The engine is now closed."
End Sub
Sub MenuEngineCloseJob_Click ()
  PEClosePrintJob (JobNum)
  JobNum = 0
  Main!StatusBar.Caption = "Job closed."
End Sub
Sub MenuEngineOpen_Click ()
'Open the Crystal Reports Print engine(i.e CRPE.DLL)
'Return of True(1) or false(0)
    If PEOpenEngine() = False Then
      Main!StatusBar.Caption = "The engine did not open"
    Else
      Main!StatusBar.Caption = "The engine is now open"
    End If
'Check to see if Print job already exists
    If JobNum <> 0 Then
      Main!StatusBar.Caption = "Job is already open"
    End If
End Sub
Sub MenuEngineOpenJob_Click ()
'Invoke common dialogue to choose a report file name
    CMDialog1.Action = 1
'Open Print job using specified file name. The return value
'is either true(1) or false(0)
    If CMDialog1.Filename <> "" Then
        JobNum = PEOpenPrintJob(CMDialog1.Filename)
        If JobNum <> 0 Then
            Main!StatusBar.Caption = "Job opened."
        Else
            Main!StatusBar.Caption = "Error = " & Str$(JobNum) + " occured while trying to open the print job"
        End If
    End If
End Sub
Sub MenuFieldsGroupSortFields_Click ()
 GSort.Show
End Sub
Sub MenuFieldsRecordSortField_Click ()
 Sort.Show
End Sub
Sub MenuFileClose_Click ()
    If Forms.Count > 1 Then
        Unload ActiveForm
        If Forms.Count = 1 Then
            MenuFileClose.Enabled = False
        End If
    End If
End Sub
Sub MenuFileExit_Click ()
    Unload Me
End Sub
Sub MenuFileNew_Click ()
Dim C As New Child
Dim JobNum As Integer
'Open the Crystal Reports Print engine(i.e CRPE.DLL)
'Return of True(1) or false(0)
    If PEOpenEngine() = False Then
      Main!StatusBar.Caption = "The engine did not open"
    Else
      Main!StatusBar.Caption = "The engine is now open"
    End If
'Check to see if Print job already exists
    If JobNum <> 0 Then
      Main!StatusBar.Caption = "Job is already open"
    End If
'Invoke common dialogue to choose a report file name
    CMDialog1.Action = 1
'Open Print job using specified file name. The return value
'is either true(1) or false(0)
    If CMDialog1.Filename <> "" Then
        JobNum = PEOpenPrintJob(CMDialog1.Filename)
        If JobNum <> 0 Then
            Main!StatusBar.Caption = "Job opened."
        Else
            Main!StatusBar.Caption = "Error = " & Str$(JobNum) + " occured while trying to open the print job"
        End If
    End If
'Set the report window handle equal to that of the MDI child
'form so that our print window prints inside of the Window frame
'created by the Windows API call
    Report_ParentWindowHandle = C.hWnd
    Screen.MousePointer = 11
    C.Caption = "MDIChild - " & Forms.Count
'Set the border style of the print window so that it has no border,max or min
'buttons, control box etc.
    'Border_style% = 268435456
'Send the Print job to be printed to a window
    If PEOutPutToWindow(JobNum, C.Caption, ScaleLeft, ScaleTop, ScaleWidth, ScaleHeight, 268435456, C.hWnd) = False Then
      Main!StatusBar.Caption = "Output to Window has failed."
    Else
      Main!StatusBar.Caption = "Output to Window was successful."
    End If
'Starts the desired print job
    If PEStartPrintJob(JobNum, True) = False Then
      Main!StatusBar.Caption = "Printing To Window has failed."
    Else
      Main!StatusBar.Caption = "Printing to Window was successful."
    End If
    Main!StatusBar.Caption = " Active Window :- " & C.Caption
    MenuFileClose.Enabled = True
    Screen.MousePointer = 0
End Sub
Sub MenuFormatMinSectionHeight_Click ()
 MsgBox "Not Yet Implemented!"
End Sub
Sub MenuFormatRptTitle_Click ()
  RPTTITLE.Show
End Sub
Sub MenuFormatSetLineHeight_Click ()
 MsgBox "Not Yet Implemented!"
End Sub
Sub MenuFormatSetMargins_Click ()
 MsgBox "Not Yet Implemented!"
End Sub
Sub MenuFormatSetSecFormat_Click ()
 Section.Show
End Sub
Sub MenuFormatSetSectionFont_Click ()
'Invoke common dialogue to choose a report file name
    'CMDialog1.Action = 4
     Font.Show
End Sub
Sub MenuFormulasSetFormula_Click ()
 SetFormula.Show
End Sub
Sub MenuFormulasSetSelForm_Click ()
  SetFormula.Show
End Sub
Sub MenuGroupCond_Click ()
 Groupcond.Show
End Sub
Sub MenuLogoff_Click ()
    Dim logonInfo As PELogonInfo
    logonInfo.StructSize = Len(logonInfo)
    logonInfo.ServerName = "ODBCSQL" + Chr$(0)
    logonInfo.DatabaseName = "pubs" + Chr$(0)
    logonInfo.UserID = "tech" + Chr$(0)
    logonInfo.Password = "tech" + Chr$(0)
    If PELogOFFServer("PDSODBC.DLL", logonInfo) = 1 Then
       MsgBox ("PELogOFFServer Succeeded!")
    Else
      RCode = GetErrorString(JobNum)
      MsgBox "PELogOFFServer Error #: " + Str(ErrorCode) + " - " + RCode
    End If
End Sub
Sub MenuLogon_Click ()
    Dim logonInfo As PELogonInfo
    logonInfo.StructSize = Len(logonInfo)
    logonInfo.ServerName = "ODBCSQL" + Chr$(0)
    logonInfo.DatabaseName = "pubs" + Chr$(0)
    logonInfo.UserID = "tech" + Chr$(0)
    logonInfo.Password = "tech" + Chr$(0)
    If PELogOnServer("PDSODBC.DLL", logonInfo) = 1 Then
      MsgBox ("PELogOnServer Succeeded!")
    Else
      RCode = GetErrorString(JobNum)
      MsgBox "PELogOnServer Error #: " + Str(ErrorCode) + " - " + RCode
    End If
End Sub
Sub MenuLogonInfo_Click ()
 SETLOGON.Show
End Sub
Sub MenuModSQL_Click ()
 SQLQUERY.Show
End Sub
Sub MenuPrintdestination_Click ()
 Outputdest.Show 1
End Sub
Sub MenuPrintFile_Click ()
Dim Path As String
Path = InputBox("Please enter text file name with path:", "Text File Name")
If PEOutPutToFile(JobNum, Path, 2, 0) = 1 Then
    MsgBox ("Export to file was successful!")
 Else
    MsgBox ("Export to file has failed!")
 End If
End Sub
Sub MenuPrintStart_Click ()
'Starts the desired print job
    If PEStartPrintJob(JobNum, True) = False Then
      RCode = GetErrorString(JobNum)
      MsgBox "PEStartPrintJob Error #: " + Str(ErrorCode) + " - " + RCode
    Else
      Outputdest!StatusBar.Caption = "Print Job was Successful."
    End If
End Sub
Sub MenuPrintWindow_Click ()
Dim C As New Child
    Report_ParentWindowHandle = C.hWnd
    'Screen.MousePointer = 11
    C.Caption = "MDIChild - " & Forms.Count
'Set the border style of the print window so that it has no border,max or min
'buttons, control box etc.
    'Border_style% = 268435456
'Send the Print job to be printed to a window
    If PEOutPutToWindow(JobNum, C.Caption, ScaleLeft, ScaleTop, ScaleWidth, ScaleHeight, 268435456, C.hWnd) = False Then
      Main!StatusBar.Caption = "Output to Window has failed."
    Else
      Main!StatusBar.Caption = "Output to Window was successful."
    End If
End Sub
Sub MenuSecurity_Click ()
 Security.Show
End Sub
Sub MenuServerManagementLogoffServer_Click ()
    Dim logonInfo As PELogonInfo
    logonInfo.StructSize = Len(logonInfo)
    logonInfo.ServerName = "ODBCSQL" + Chr$(0)
    logonInfo.DatabaseName = "pubs" + Chr$(0)
    logonInfo.UserID = "tech" + Chr$(0)
    logonInfo.Password = "tech" + Chr$(0)
    If PELogOFFServer("PDSODBC.DLL", logonInfo) = 1 Then
       MsgBox ("PELogOFFServer Succeeded!")
    Else
      RCode = GetErrorString(JobNum)
      MsgBox "PELogOFFServer Error #: " + Str(ErrorCode) + " - " + RCode
    End If
End Sub
Sub MenuServerManagementLogonInfo_Click ()
  SETLOGON.Show
End Sub
Sub MenuServerManagementLogonServer_Click ()
    Dim logonInfo As PELogonInfo
    logonInfo.StructSize = Len(logonInfo)
    logonInfo.ServerName = "ODBCSQL" + Chr$(0)
    logonInfo.DatabaseName = "pubs" + Chr$(0)
    logonInfo.UserID = "tech" + Chr$(0)
    logonInfo.Password = "tech" + Chr$(0)
    If PELogOnServer("PDSODBC.DLL", logonInfo) = 1 Then
      MsgBox ("PELogOnServer Succeeded!")
    Else
      RCode = GetErrorString(JobNum)
      MsgBox "PELogOnServer Error #: " + Str(ErrorCode) + " - " + RCode
    End If
End Sub
Sub MenuServerManagementSQLQuery_Click ()
 SQLQUERY.Show
End Sub
Sub MenuWindowArrange_Click ()
    Me.Arrange ARRANGE_ICONS
End Sub
Sub MenuWindowCascade_Click ()
    Me.Arrange CASCADE
End Sub
Sub MenuWindowTileH_Click ()
    Me.Arrange TILE_HORIZONTAL
End Sub
Sub MenuWindowTileV_Click ()
    Me.Arrange TILE_VERTICAL
End Sub
Sub Preview_Click ()
Dim C As New Child
Dim JobNum As Integer
'Open the Crystal Reports Print engine(i.e CRPE.DLL)
'Return of True(1) or false(0)
    If PEOpenEngine() = False Then
      Main!StatusBar.Caption = "The engine did not open"
    Else
      Main!StatusBar.Caption = "The engine is now open"
    End If
'Check to see if Print job already exists
    If JobNum <> 0 Then
      Main!StatusBar.Caption = "Job is already open"
    End If
'Invoke common dialogue to choose a report file name
    CMDialog1.Action = 1
'Open Print job using specified file name. The return value
'is either true(1) or false(0)
    If CMDialog1.Filename <> "" Then
        JobNum = PEOpenPrintJob(CMDialog1.Filename)
        If JobNum <> 0 Then
            Main!StatusBar.Caption = "Job opened."
        Else
            Main!StatusBar.Caption = "Error = " & Str$(JobNum) + " occured while trying to open the print job"
        End If
    End If
'Set the report window handle equal to that of the MDI child
'form so that our print window prints inside of the Window frame
'created by the Windows API call
    Report_ParentWindowHandle = C.hWnd
    Screen.MousePointer = 11
    C.Caption = "MDIChild - " & Forms.Count
'Set the border style of the print window so that it has no border,max or min
'buttons, control box etc.
    'Border_style% = 268435456
'Send the Print job to be printed to a window
    If PEOutPutToWindow(JobNum, C.Caption, ScaleLeft, ScaleTop, ScaleWidth, ScaleHeight, 268435456, C.hWnd) = False Then
      Main!StatusBar.Caption = "Output to Window has failed."
    Else
      Main!StatusBar.Caption = "Output to Window was successful."
    End If
'Starts the desired print job
    If PEStartPrintJob(JobNum, True) = False Then
      Main!StatusBar.Caption = "Printing To Window has failed."
    Else
      Main!StatusBar.Caption = "Printing to Window was successful."
    End If
    Main!StatusBar.Caption = " Active Window :- " & C.Caption
    MenuFileClose.Enabled = True
    Screen.MousePointer = 0
End Sub